ANÁLISE DOS JOGOS OLÍMPICOS MODERNOS

AV2 - INTRODUÇÃO À CIÊNCIA DE DADOS

Amon Chalegre Gomes Vanderlei e Pedro Paulo Gomes Paiva

INTRODUÇÃO

Os Jogos Olímpicos representam um dos maiores eventos esportivos do mundo, reunindo países de diferentes continentes. Neste trabalho, buscaremos explorar duas frentes complementares. Primeiro, analisaremos aspectos gerais das Olimpíadas, apresentando um panorama histórico e descritivo dos Jogos Olímpicos Modernos. Em seguida, aprofundaremos a análise na pergunta: “Qual é o impacto de sediar os Jogos Olímpicos sobre o desempenho de um país?”. Para responder a questão, utilizaremos duas métricas para comparar o desempenho médio das nações quando atuam como anfitriãs e o desempenho médio quando competem como visitantes. A partir dessas medidas, buscaremos identificar a existência de um “efeito sede” e comparar o desempenho do Brasil com a performance geral.

BASE DE DADOS

Os dados utilizados neste trabalho foram obtidos a partir do repositório Historical Data from the Olympics, disponível na plataforma Base dos Dados. O conjunto é uma tentativa de criar uma base de dados atualizada com informações sobre os Jogos Olímpicos. A partir dessas bases, realizamos etapas de limpeza, padronização e agregação das informações, construindo métricas próprias para avaliar o desempenho médio dos países como sede e como não sede. Os dados contidos nessas bases de dados abrange todos os jogos que ocorreram entre a edição de 1896 em Atenas e a edição de 2022 em Beijing, portanto os resultados dos jogos olímpicos de 2024 em Paris e os jogos de 2026 em Milão/Cortina não serão levados em consideração nesta análise.

As análises foram conduzidas utilizando a linguagem R e todo o código utilizado para limpeza, construção das métricas e geração das visualizações está disponível no repositório do projeto no GitHub. Além disso, as seguintes bibliotecas foram utilizadas:

# install.packages(c("tidyverse", "ggrepel", "countrycode", "gt", "sf", "rnaturalearth", "rnaturalearthdata", "tidygeocoder", "patchwork"))
# remotes::install_github("ropensci/rnaturalearthhires")

library(sf)
library(gt)
library(ggrepel)
library(patchwork)
library(tidyverse)
library(countrycode)
library(tidygeocoder)
library(rnaturalearth)
library(rnaturalearthdata)
library(rnaturalearthhires)

As seguintes bases serão utilizadas ao longo da análise:

game <- read_csv("../data/raw/game.csv.gz")
country <- read.csv("../data/raw/country.csv.gz")
athlete_bio <- read.csv("../data/raw/athlete_bio.csv.gz")
game_medal_tally <- read_csv("../data/raw/game_medal_tally.csv.gz")
athlete_event_result <- read_csv("../data/raw/athlete_event_result.csv.gz")

LIMPEZA DOS DADOS

Antes da construção das métricas e visualizações, foi realizada uma etapa de tratamento e padronização das bases, pois os dados são provenientes de diferentes tabelas. Inicialmente, removemos os Jogos Intercalados de 1906, uma vez que suas premiações não são oficialmente reconhecidas pelo Comitê Olímpico Internacional. Também desconsideramos edições que não foram realizadas e padronizamos a variável edition para distinguir apenas entre Jogos de Verão e Jogos de Inverno. Um ponto específico tratado foi o caso do hipismo em 1956. Embora as provas equestres tenham ocorrido em Estocolmo (Suécia), devido às restrições sanitárias da Austrália, elas foram incorporadas à edição de Melbourne para manter a coerência histórica da sede.

Na base de atletas, selecionamos apenas as variáveis relevantes para a análise e removemos registros duplicados. Consideramos que, em uma mesma edição, um atleta pode participar apenas uma vez de uma determinada prova representando um único país. Quando havia múltiplos registros para a mesma combinação de atleta, edição e evento, mantivemos apenas um, priorizando, quando aplicável, o registro com premiação. Além disso, identificamos seis atletas com informações ausentes de nome e sexo. Esses dados foram completados manualmente a partir do identificador do atleta, utilizando como referência a plataforma Olympedia.

game <- game |> 
  # Retira as sedes de jogos que não ocorreram ou não são considerados
  filter(
    edition != "1906 Intercalated",
    edition != "1956 Equestrian",
    is.na(is_held),
    year <= 2022
  ) |> 
  mutate(
    edition = case_when(
      str_detect(edition, "Summer") ~ "Olimpíadas de Verão",
      str_detect(edition, "Winter") ~ "Olimpíadas de Inverno"
    )
  ) |>
  select(edition_id, edition, country_flag_url, city, host_country = country_noc)

country <- country |> 
  # Retira sigla "ROC" duplicada
  filter(name != "ROC")

athlete_bio <- athlete_bio |>
  select(athlete_id, sex, name) |>
  mutate(athlete_id = as.numeric(athlete_id))

game_medal_tally <- game_medal_tally |>
  # Atrela o hipismo à sede na Austrália
  mutate(edition_id = replace(edition_id, edition_id == 48, 14)) |>
  # Retira os jogos intercalados
  filter(year != 1906) |>
  mutate(
    edition = case_when(
      str_detect(edition, "Summer") ~ "Olimpíadas de Verão",
      str_detect(edition, "Equestrian") ~ "Olimpíadas de Verão",
      str_detect(edition, "Winter") ~ "Olimpíadas de Inverno"
      )
    )

athlete_event_result <- athlete_event_result |>
  mutate(
    year = as.integer(str_extract(edition, "^\\d{4}")),
    # Atrela o hipismo à sede na Austrália
    edition_id = replace(edition_id, edition_id == 48, 14),
    edition = case_when(
      str_detect(edition, "Summer") ~ "Olimpíadas de Verão",
      str_detect(edition, "Equestrian") ~ "Olimpíadas de Verão",
      str_detect(edition, "Winter") ~ "Olimpíadas de Inverno",
      TRUE                          ~ "other"
    ),
    medal = na_if(medal, "")
  ) |>
  # Retira os jogos intercalados
  filter(year != 1906) |>
  select(
    year,
    edition_id,
    edition,
    country_noc,
    athlete_id,
    sport,
    event,
    medal
  ) |>
  # Remove duplicatas
  arrange(athlete_id, edition_id, sport, event, medal) |>
  group_by(athlete_id, edition_id, sport, event) |>
  slice(1) |>
  ungroup()

athlete_bio_result <- athlete_event_result |>
  left_join(athlete_bio, by = "athlete_id") |>
  # Preenche dados faltantes
  mutate(
    name = case_when(
      athlete_id == 69534 ~ "John Thornton",
      athlete_id == 36110 ~ "Frank Courtney",
      athlete_id == 2302137 ~ "Peter Hunter Gaskell",
      athlete_id == 902283 ~ "Kay Todd, Jr.",
      athlete_id == 920957 ~ "Hoka Iwabuchi",
      athlete_id == 37833 ~ "Hans Joachim Hannemann",
      TRUE ~ name
    ),
    sex = case_when(
      athlete_id %in% c(69534,36110,2302137,902283,920957,37833) ~ "Male",
      TRUE ~ sex)
  )

ANÁLISE GERAL

TRATAMENTO DE DADOS

Para estas análises vamos necessitar de mais algumas etapas de tratamentos de dados, utilizando as bases tratadas anteriormente.

# União das Bases de Dados
dados_participacoes <- athlete_bio_result %>% 
  # Tradução de Variáveis
  transmute(ano = year,
         edicao_id = edition_id,
         estacao = case_when(str_detect(edition, "Verão") ~ "Verão",
                             str_detect(edition, "Inverno") ~ "Inverno"),
         atleta_id = athlete_id,
         nome = str_trim(name),
         pais_sg = country_noc,
         sexo = case_when(sex == "Male" ~ "Homem",
                             sex == "Female" ~"Mulher"),
         esporte = sport,
         modalidade = event,
         medalha = factor(medal,
                             level = c("Gold", "Silver", "Bronze"),
                             labels = c("Ouro", "Prata", "Bronze")))

Também vamos coletar a posição espacial (latitude e longitude) de todas as cidades que já sediaram os jogos olímpicos.

# Tradução de Variáveis
siglas_convercao <- country %>% 
  transmute(pais_sg = noc,
            pais = name)

dados_latlong <- game %>% 
  # Tradução de Variáveis
  mutate(edicao_id = edition_id,
         estacao = case_when(str_detect(edition, "Verão") ~ "Verão",
                             str_detect(edition, "Inverno") ~ "Inverno"),
         cidade = city,
         pais_sg = host_country,
         bandeira_url = country_flag_url) %>% 
  # Inserir o Nome dos Países
  geocode(city = cidade, method = 'osm', lat = latitude , long = longitude) %>% 
  left_join(siglas_convercao, by = "pais_sg") %>% 
  select(edicao_id, estacao, cidade, pais_sg, pais, bandeira_url, latitude, longitude)

Para iniciar a análise, vamos filtrar dois dataframes que vão ser muito utilizados ao longo do processo:

dados_participacoes_verao <- dados_participacoes %>% 
  filter(estacao == "Verão")

dados_participacoes_inverno <- dados_participacoes %>% 
  filter(estacao == "Inverno")

NÚMERO DE ATLETAS

Vamos iniciar fazendo um levantamento do número de atletas nas olímpiadas ao longo do tempo e como os acontecimentos geopolíticos influênciam na participação nos jogos.

# Participações Verão
participantes_ano <- dados_participacoes_verao |> 
  group_by(ano) |> 
  distinct(atleta_id, .keep_all = TRUE) |> 
  summarise(contagem = n())

# Anos Importantes
pontos_relevantes <- data.frame(
  x = c(1932, 1956, 1980),
  y = c(2057, 3549, 5383),
  l = c("Grande Depressão", "Triplo Boicote", "Guerra Fria")
)

# Plotagem
ggplot(participantes_ano, aes(x = ano, y = contagem)) + 
  geom_area(linewidth = 2,
            color = winter_swiss_1928_palette$primary[1],
            fill = winter_swiss_1928_palette$primary[1],
            alpha = 0.8) + 
  # Anos Importantes
  geom_point(data = pontos_relevantes,
             aes(x = x, y = y),
             color = winter_swiss_1928_palette$primary[2],
             size = 3) + 
  geom_text(data = pontos_relevantes, 
            aes(x = x, y = y, label = l),
            vjust = 2,
            color = "#FFFFFF",
            fontface = "bold",
            size = 3.5) +
  # Temas, Escalas e Legendas
  scale_x_continuous(breaks = seq(1896, 2020, by = 31)) + 
  labs(title = "NÚMERO DE ATLETAS AO LONGO DO TEMPO",
       subtitle = "Olimpíadas de Verão | 1896 Atenas – 2020 Tokyo",
       x = "ANO",
       y = "NÚMERO DE PARTICIPANTES") + 
  theme_olympics()

# Participações Inverno
participantes_ano <- dados_participacoes_inverno |>
  group_by(ano) |> 
  distinct(atleta_id, .keep_all = TRUE) |> 
  summarise(contagem = n())

# Anos Importantes
pontos_relevantes <- data.frame(
  x = c(1932, 1960, 1972, 1994),
  y = c(385, 670, 1024, 1765),
  l = c("Grande Depressão", "Bobsled", "Dinâmica Logistíca", "Novo Ciclo")
)

ggplot(participantes_ano, aes(x = ano, y = contagem)) + 
  geom_area(linewidth = 2,
            color = winter_swiss_1928_palette$primary[3],
            fill = winter_swiss_1928_palette$primary[3],
            alpha = 0.8) + 
  # Anos Importantes
  geom_point(data = pontos_relevantes,
             aes(x = x, y = y),
             color = winter_swiss_1928_palette$primary[2],
             size = 3) + 
  geom_text(data = pontos_relevantes, 
            aes(x = x, y = y, label = l),
            vjust = 2.2,
            hjust = -0.05,
            color = "#FFFFFF",
            fontface = "bold",
            size = 3.5) +
  # Temas, Escalas e Legendas
  scale_x_continuous(breaks = seq(1924, 2022, by = 14)) + 
  scale_y_continuous(breaks = seq(0, 3000, by = 500), limits = c(0, 3000)) + 
  labs(title = "NÚMERO DE ATLETAS AO LONGO DO TEMPO",
       subtitle = "Olimpíadas de Inverno | 1924 Chamonix – 2022 Beijing",
       x = "ANO",
       y = "NÚMERO DE PARTICIPANTES") + 
  theme_olympics()

# Participações Verão Brasil
participantes_ano <- dados_participacoes_verao |> 
  filter(pais_sg == "BRA") |>
  group_by(ano) |> 
  distinct(atleta_id, .keep_all = TRUE) |> 
  summarise(contagem = n())

# Plotagem
ggplot(participantes_ano, aes(x = ano, y = contagem)) + 
  geom_area(linewidth = 2,
            color = summer_brasil_2016_palette$primary[4],
            fill = summer_brasil_2016_palette$primary[3],
            alpha = 0.8) + 
  # Temas, Escalas e Legendas
  scale_x_continuous(breaks = seq(1920, 2020, by = 20)) + 
  labs(title = "NÚMERO DE ATLETAS BRASILEIROS AO LONGO DO TEMPO",
       subtitle = "Olimpíadas de Verão | 1920 Antuérpia – 2020 Tokyo",
       x = "ANO",
       y = "NÚMERO DE PARTICIPANTES") + 
  theme_olympics()

# Participações Inverno Brasil
participantes_ano <- dados_participacoes_inverno |>
  filter(pais_sg == "BRA") |>
  group_by(ano) |> 
  distinct(atleta_id, .keep_all = TRUE) |> 
  summarise(contagem = n())

# Plotagem
ggplot(participantes_ano, aes(x = ano, y = contagem)) + 
  geom_area(linewidth = 2,
            color = summer_brasil_2016_palette$primary[2],
            fill = summer_brasil_2016_palette$primary[2],
            alpha = 0.8) + 
  # Temas, Escalas e Legendas
  scale_x_continuous(breaks = seq(1992, 2022, by = 6)) + 
  labs(title = "NÚMERO DE ATLETAS BRASILEIROS AO LONGO DO TEMPO",
       subtitle = "Olimpíadas de Inverno | 1992 Albertvill – 2022 Beijing",
       x = "ANO",
       y = "NÚMERO DE PARTICIPANTES") + 
  theme_olympics()

Com base nos gráficos elaborados acima, podemos concluir que as olimpíadas de verão em especial sofrem grande impacto de aspectos geopolíticos, enquanto isso, as olimpíadas de inverno por sua vez, possuem dificuldades mais relacionadas à esfera econômica e limite de verbas.

ANÁLISE POR GÊNERO

Após isso vamos fazer uma divisão por gênero para entender o comportamento da quantidade de atletas mulheres e o seu percentual quando comparado ao número de atletas masculinos.

# Pirâmide Gênero - Verão
piramide_genero_dados <- dados_participacoes_verao |>
  group_by(ano, sexo) |>
  summarise(total = n_distinct(atleta_id), .groups = "drop") |>
  # Considera homens como valor negativo para separar pelo eixo
  mutate(
    valor_grafico = ifelse(sexo == "Homem", -total, total),
    ano_fct = factor(ano, levels = sort(unique(ano), decreasing = TRUE))
  )

# Gráfico
ggplot(piramide_genero_dados, aes(x = ano_fct, y = valor_grafico, fill = sexo)) +
  geom_col(width = 0.8) + 
  # Inverte os eixos para termos o gráfico de barras horizontais
  coord_flip() + 
  scale_y_continuous(labels = abs,
                     breaks = seq(-7000, 7000, by = 1000),
                     limits = c(-7500, 7500)) + 
  scale_fill_manual(values = c("Homem" = winter_swiss_1928_palette$primary[3],
                               "Mulher" = winter_swiss_1928_palette$primary[1]),
                    labels = c("Homens", "Mulheres")) +
  # Tema, Títulos e Legendas
  labs(
    title = "EVOLUÇÃO DA PARTICIPAÇÃO POR GÊNERO",
    subtitle = "Olimpíadas de Verão | 1896 Atenas – 2020 Tokyo",
    x = "EDIÇÃO",
    y = "TOTAL DE ATLETAS",
    fill = "GÊNERO"
  ) + 
  theme_olympics() + 
  theme(axis.text.y = element_text(size = 8),
        panel.grid.major.x = element_line(color = "gray85"))

# Pirâmide Gênero - Inverno
piramide_genero_dados <- dados_participacoes_inverno |>
  group_by(ano, sexo) |>
  summarise(total = n_distinct(atleta_id), .groups = "drop") |>
  # Considera homens como valor negativo para separar pelo eixo
  mutate(
    valor_grafico = ifelse(sexo == "Homem", -total, total),
    ano_fct = factor(ano, levels = sort(unique(ano), decreasing = TRUE))
  )

# Gráfico
ggplot(piramide_genero_dados, aes(x = ano_fct, y = valor_grafico, fill = sexo)) +
  geom_col(width = 0.8) + 
  # Inverte os eixos para termos o gráfico de barras horizontais
  coord_flip() + 
  scale_y_continuous(labels = abs,
                     breaks = seq(-1750, 1750, by = 250),
                     limits = c(-1750, 1750)) + 
  scale_fill_manual(values = c("Homem" = winter_swiss_1928_palette$primary[3],
                               "Mulher" = winter_swiss_1928_palette$primary[1]),
                    labels = c("Homens", "Mulheres")) +
  # Tema, Títulos e Legendas
  labs(
    title = "EVOLUÇÃO DA PARTICIPAÇÃO POR GÊNERO",
    subtitle = "Olimpíadas de Inverno | 1924 Chamonix – 2022 Beijing",
    x = "EDIÇÃO",
    y = "TOTAL DE ATLETAS",
    fill = "GÊNERO"
  ) + 
  theme_olympics() + 
  theme(axis.text.y = element_text(size = 8),
        panel.grid.major.x = element_line(color = "gray85"))

Vamos fazer um filtro para fazer a mesma análise para os atletas do Brasil.

# Pirâmide Gênero Brasil - Verão
piramide_genero_dados <- dados_participacoes_verao |>
  filter(pais_sg == "BRA") |>
  group_by(ano, sexo) |>
  summarise(total = n_distinct(atleta_id), .groups = "drop") |>
  # Considera homens como valor negativo para separar pelo eixo
  mutate(
    valor_grafico = ifelse(sexo == "Homem", -total, total),
    ano_fct = factor(ano, levels = sort(unique(ano), decreasing = TRUE)))

# Gráfico
ggplot(piramide_genero_dados, aes(x = ano_fct, y = valor_grafico, fill = sexo)) +
  geom_col(width = 0.8) + 
  # Inverte os eixos para termos o gráfico de barras horizontais
  coord_flip() + 
  scale_y_continuous(labels = abs,
                     breaks = seq(-300, 300, by = 50),
                     limits = c(-300, 300)) + 
  scale_fill_manual(values = c("Homem" = summer_brasil_2016_palette$primary[2],
                               "Mulher" = summer_brasil_2016_palette$primary[3]),
                    labels = c("Homens", "Mulheres")) +
  # Tema, Títulos e Legendas
  labs(
    title = "EVOLUÇÃO DA PARTICIPAÇÃO POR GÊNERO DO BRASIL",
    subtitle = "Olimpíadas de Verão | 1920 Antuérpia – 2020 Tokyo",
    x = "EDIÇÃO",
    y = "TOTAL DE ATLETAS",
    fill = "GÊNERO"
  ) + 
  theme_olympics() + 
  theme(axis.text.y = element_text(size = 8),
        panel.grid.major.x = element_line(color = "gray85"))

# Pirâmide Gênero Brasil - Inverno
piramide_genero_dados <- dados_participacoes_inverno |>
  filter(pais_sg == "BRA") |>
  group_by(ano, sexo) |>
  summarise(total = n_distinct(atleta_id), .groups = "drop") |>
  # Considera homens como valor negativo para separar pelo eixo
  mutate(
    valor_grafico = ifelse(sexo == "Homem", -total, total),
    ano_fct = factor(ano, levels = sort(unique(ano), decreasing = TRUE)))

# Gráfico
ggplot(piramide_genero_dados, aes(x = ano_fct, y = valor_grafico, fill = sexo)) +
  geom_col(width = 0.8) + 
  # Inverte os eixos para termos o gráfico de barras horizontais
  coord_flip() + 
  scale_y_continuous(labels = abs,
                     breaks = seq(-10, 10, by = 1),
                     limits = c(-10, 10)) + 
  scale_fill_manual(values = c("Homem" = summer_brasil_2016_palette$primary[2],
                               "Mulher" = summer_brasil_2016_palette$primary[3]),
                    labels = c("Homens", "Mulheres")) +
  # Tema, Títulos e Legendas
  labs(
    title = "EVOLUÇÃO DA PARTICIPAÇÃO POR GÊNERO DO BRASIL",
    subtitle = "Olimpíadas de Inverno | 1992 Albertvill – 2022 Beijing",
    x = "EDIÇÃO",
    y = "TOTAL DE ATLETAS",
    fill = "GÊNERO"
  ) + 
  theme_olympics() + 
  theme(panel.grid.major.x = element_line(color = "gray85"))

Podemos ver que o percentual de mulheres participando dos jogos olímpicos era muito discreto, com um crescimento acelerado que tem início após a primeira metade do século XX, chegando em níveis comparáveis com a parcela masculina apenas nas última edições dos jogos.

ANÁLISE POR PAÍS

Agora vamos ver os resultados de medalhas gerais por país:

dados_paises <- game_medal_tally |>
  mutate(estacao = case_when(str_detect(edition, "Verão") ~ "Verão",
                             str_detect(edition, "Inverno") ~ "Inverno"))

# Quadro Medalhas Países
tabela_medalhas <- dados_paises |> 
  group_by(country_noc) |>
  # Tabela com o número de medalhas por país
  summarise(
    ouro   = sum(gold, na.rm = TRUE),
    prata  = sum(silver, na.rm = TRUE),
    bronze = sum(bronze, na.rm = TRUE),
    .groups = "drop") |>
  mutate(total_geral = ouro + prata + bronze) |>
  # Ordena por ouro, prata e bronze
  arrange(desc(ouro), desc(prata), desc(bronze)) |> 
  # Seleciona os 10 maiores e traduz
  slice(1:10) |>
  mutate(pais = case_match(country_noc,
    "USA" ~ "Estados Unidos",
    "URS" ~ "União Soviética",
    "GER" ~ "Alemanha",
    "GBR" ~ "Grã-Bretanha",
    "FRA" ~ "França",
    "ITA" ~ "Itália",
    "CHN" ~ "China",
    "SWE" ~ "Suécia",
    "NOR" ~ "Noruega",
    "RUS" ~ "Rússia")) |>
  select(pais, ouro, prata, bronze, total_geral)

# Elaboração da tabela
tabela_medalhas |>
  gt() |>
  # Cabeçalho e Títulos
  tab_header(
    title = md("**QUADRO HISTÓRICO DE MEDALHAS**"),
    subtitle = md("Países com Melhor Desempenho nos Jogos na História<br>(1896 Atenas – 2022 Beijing)")) |>
  tab_style(
    style = cell_text(style = "italic"),
    locations = cells_title(groups = "subtitle")) |>
  cols_label(
    pais = "País", 
    ouro = "Ouro", 
    prata = "Prata", 
    bronze = "Bronze", 
    total_geral = "Total") |>
  # Cores (Degradê de Medalhas)
  data_color(columns = ouro, palette = c("#FFD70030", "#FFD700")) |>
  data_color(columns = prata, palette = c("#C0C0C030", "#C0C0C0")) |>
  data_color(columns = bronze, palette = c("#CD7F3230", "#CD7F32")) |>
  # Estilização de Texto
  tab_style(
    style = cell_text(color = "black"),
    locations = cells_body(columns = everything())) |>
  tab_style(
    style = cell_text(weight = "bold"),
    locations = cells_body(columns = pais)) |>
  # Formatação Numérica e Alinhamento
  fmt_number(
    columns = c(ouro, prata, bronze, total_geral), 
    decimals = 0, 
    use_seps = TRUE, 
    sep_mark = ".", 
    dec_mark = ",") |>
  cols_align(align = "left", columns = pais) |>
  cols_align(align = "center", columns = c(ouro, prata, bronze, total_geral)) |>
  # Layout
  tab_options(
    heading.title.font.size = 24,
    column_labels.font.weight = "bold",
    table.width = pct(80))

QUADRO HISTÓRICO DE MEDALHAS
Países com Melhor Desempenho nos Jogos na História (1896 Atenas – 2022 Beijing)
País	Ouro	Prata	Bronze	Total
Estados Unidos	1.183	963	839	2.985
União Soviética	473	376	355	1.204
Alemanha	351	371	361	1.083
Grã-Bretanha	304	328	332	964
China	285	231	197	713
França	272	299	340	911
Itália	264	238	271	773
Suécia	214	228	241	683
Noruega	207	187	173	567
Rússia	194	169	188	551

# Quadro Medalhas Edição de Verão
tabela_medalhas <- dados_paises |> 
  filter(estacao == "Verão") |>
  group_by(country_noc) |> 
  summarise(
    ouro   = sum(gold, na.rm = TRUE),
    prata  = sum(silver, na.rm = TRUE),
    bronze = sum(bronze, na.rm = TRUE),
    .groups = "drop") |>
  mutate(total_geral = ouro + prata + bronze) |>
  # Ordena por ouro, prata e bronze
  arrange(desc(ouro), desc(prata), desc(bronze)) |> 
  # Seleciona os 10 maiores e traduz
  slice(1:10) |>
  mutate(pais = case_match(country_noc,
    "USA" ~ "Estados Unidos",
    "URS" ~ "União Soviética",
    "GBR" ~ "Grã-Bretanha",
    "CHN" ~ "China",
    "GER" ~ "Alemanha",
    "FRA" ~ "França",
    "ITA" ~ "Itália",
    "HUN" ~ "Hungria",
    "JPN" ~ "Japão",
    "AUS" ~ "Austrália")) |>
  select(pais, ouro, prata, bronze, total_geral)

# Elaboração da tabela
tabela_medalhas |>
  gt() |>
  # Cabeçalho e Títulos
  tab_header(
    title = md("**QUADRO HISTÓRICO DE MEDALHAS**"),
    subtitle = md("Países com Melhor Desempenho nos Jogos na História<br>(Olimpíadas de Verão | 1896 Atenas – 2020 Tokyo)")) |>
  tab_style(
    style = cell_text(style = "italic"),
    locations = cells_title(groups = "subtitle")) |>
  cols_label(
    pais = "País", 
    ouro = "Ouro", 
    prata = "Prata", 
    bronze = "Bronze", 
    total_geral = "Total") |>
  # Cores (Degradê de Medalhas)
  data_color(columns = ouro, palette = c("#FFD70030", "#FFD700")) |>
  data_color(columns = prata, palette = c("#C0C0C030", "#C0C0C0")) |>
  data_color(columns = bronze, palette = c("#CD7F3230", "#CD7F32")) |>
  # Estilização de Texto
  tab_style(
    style = cell_text(color = "black"),
    locations = cells_body(columns = everything())) |>
  tab_style(
    style = cell_text(weight = "bold"),
    locations = cells_body(columns = pais)) |>
  # Formatação Numérica e Alinhamento
  fmt_number(
    columns = c(ouro, prata, bronze, total_geral), 
    decimals = 0, 
    use_seps = TRUE, 
    sep_mark = ".", 
    dec_mark = ",") |>
  cols_align(align = "left", columns = pais) |>
  cols_align(align = "center", columns = c(ouro, prata, bronze, total_geral)) |>
  # Layout
  tab_options(
    heading.title.font.size = 24,
    column_labels.font.weight = "bold",
    table.width = pct(80))

QUADRO HISTÓRICO DE MEDALHAS
Países com Melhor Desempenho nos Jogos na História (Olimpíadas de Verão | 1896 Atenas – 2020 Tokyo)
País	Ouro	Prata	Bronze	Total
Estados Unidos	1.070	841	744	2.655
União Soviética	395	319	296	1.010
Grã-Bretanha	292	323	315	930
China	263	199	174	636
Alemanha	239	267	291	797
França	231	257	285	773
Itália	222	195	215	632
Hungria	182	156	177	515
Japão	169	150	180	499
Austrália	162	170	209	541

# Quadro Medalhas Edição de Inverno
tabela_medalhas <- dados_paises |>
  filter(estacao == "Inverno") |>
  group_by(country_noc) |> 
  summarise(
    ouro   = sum(gold, na.rm = TRUE),
    prata  = sum(silver, na.rm = TRUE),
    bronze = sum(bronze, na.rm = TRUE),
    .groups = "drop") |>
  mutate(total_geral = ouro + prata + bronze) |>
  # Ordena por ouro, prata e bronze
  arrange(desc(ouro), desc(prata), desc(bronze)) |> 
  # Seleciona os 10 maiores e traduz
  slice(1:10) |>
  mutate(pais = case_match(country_noc,
    "NOR" ~ "Noruega",
    "USA" ~ "Estados Unidos",
    "GER" ~ "Alemanha",
    "URS" ~ "União Soviética",
    "CAN" ~ "Canadá",
    "AUT" ~ "Áustria",
    "SWE" ~ "Suécia",
    "SUI" ~ "Suíça",
    "NED" ~ "Holanda",
    "RUS" ~ "Rússia")) |>
  select(pais, ouro, prata, bronze, total_geral)

# Elaboração da tabela
tabela_medalhas |>
  gt() |>
  # Cabeçalho e Títulos
  tab_header(
    title = md("**QUADRO HISTÓRICO DE MEDALHAS**"),
    subtitle = md("Países com Melhor Desempenho nos Jogos na História<br>(Olimpíadas de Inverno | 1924 Chamonix – 2022 Beijing)")) |>
  tab_style(
    style = cell_text(style = "italic"),
    locations = cells_title(groups = "subtitle")) |>
  cols_label(
    pais = "País", 
    ouro = "Ouro", 
    prata = "Prata", 
    bronze = "Bronze", 
    total_geral = "Total") |>
  # Cores (Degradê de Medalhas)
  data_color(columns = ouro, palette = c("#FFD70030", "#FFD700")) |>
  data_color(columns = prata, palette = c("#C0C0C030", "#C0C0C0")) |>
  data_color(columns = bronze, palette = c("#CD7F3230", "#CD7F32")) |>
  # Estilização de Texto
  tab_style(
    style = cell_text(color = "black"),
    locations = cells_body(columns = everything())) |>
  tab_style(
    style = cell_text(weight = "bold"),
    locations = cells_body(columns = pais)) |>
  # Formatação Numérica e Alinhamento
  fmt_number(
    columns = c(ouro, prata, bronze, total_geral), 
    decimals = 0, 
    use_seps = TRUE, 
    sep_mark = ".", 
    dec_mark = ",") |>
  cols_align(align = "left", columns = pais) |>
  cols_align(align = "center", columns = c(ouro, prata, bronze, total_geral)) |>
  # Layout
  tab_options(
    heading.title.font.size = 24,
    column_labels.font.weight = "bold",
    table.width = pct(80))

QUADRO HISTÓRICO DE MEDALHAS
Países com Melhor Desempenho nos Jogos na História (Olimpíadas de Inverno | 1924 Chamonix – 2022 Beijing)
País	Ouro	Prata	Bronze	Total
Noruega	148	134	123	405
Estados Unidos	113	122	95	330
Alemanha	112	104	70	286
União Soviética	78	57	59	194
Canadá	77	72	76	225
Áustria	71	88	91	250
Suécia	65	51	60	176
Suíça	63	47	58	168
Holanda	53	49	45	147
Rússia	46	39	35	120

Aqui observamos que os Estados Unidos e a União Soviética (extinta) se consolidam como os maiores campeões olímpico até o momento. Entretanto, quando levamos em conta apenas as medalhas dos jogos de inverno, a Noruega consegue ultrapassar ambos e se destaca como uma potência nos esportes com neve.

MAIORES MEDALHISTAS

Vamos analisar as premiações dos atletas:

# Quadro Medalhas Atletas
tabela_atletas <- dados_participacoes |> 
  group_by(atleta_id, nome) |> 
  summarise(
    ouro   = sum(medalha == "Ouro", na.rm = TRUE),
    prata  = sum(medalha == "Prata", na.rm = TRUE),
    bronze = sum(medalha == "Bronze", na.rm = TRUE),
    .groups = "drop") |> 
  mutate(total_geral = ouro + prata + bronze) |> 
  arrange(desc(ouro), desc(prata), desc(bronze)) |> 
  slice(1:10) |> 
  select(nome, ouro, prata, bronze, total_geral)

# Elaboração da tabela
tabela_atletas |>
  gt() |>
  # Cabeçalho e Títulos
  tab_header(
    title = md("**QUADRO HISTÓRICO DE MEDALHAS**"),
    subtitle = md("Atletas com Melhor Desempenho nos Jogos na História<br>(1896 Atenas – 2022 Beijing)")) |>
  tab_style(
    style = cell_text(style = "italic"),
    locations = cells_title(groups = "subtitle")) |>
  cols_label(
    nome = "Atleta", 
    ouro = "Ouro", 
    prata = "Prata", 
    bronze = "Bronze", 
    total_geral = "Total") |>
  # Cores (Degradê de Medalhas)
  data_color(columns = ouro, palette = c("#FFD70030", "#FFD700")) |>
  data_color(columns = prata, palette = c("#C0C0C030", "#C0C0C0")) |>
  data_color(columns = bronze, palette = c("#CD7F3230", "#CD7F32")) |>
  # Estilização de Texto
  tab_style(
    style = cell_text(color = "black"),
    locations = cells_body(columns = everything())) |>
  tab_style(
    style = cell_text(weight = "bold"),
    locations = cells_body(columns = nome)) |>
  # Formatação Numérica e Alinhamento
  fmt_number(
    columns = c(ouro, prata, bronze, total_geral), 
    decimals = 0, 
    use_seps = TRUE, 
    sep_mark = ".", 
    dec_mark = ",") |>
  cols_align(align = "left", columns = nome) |>
  cols_align(align = "center", columns = c(ouro, prata, bronze, total_geral)) |>
  # Layout
  tab_options(
    heading.title.font.size = 24,
    column_labels.font.weight = "bold",
    table.width = pct(80))

QUADRO HISTÓRICO DE MEDALHAS
Atletas com Melhor Desempenho nos Jogos na História (1896 Atenas – 2022 Beijing)
Atleta	Ouro	Prata	Bronze	Total
Michael Phelps	23	3	2	28
Larisa Latynina	9	5	4	18
Paavo Nurmi	9	3	0	12
Mark Spitz	9	1	1	11
Carl Lewis	9	1	0	10
Marit Bjørgen	8	4	3	15
Ole Einar Bjørndalen	8	4	1	13
Birgit Fischer-Schmidt	8	4	0	12
Bjørn Dæhlie	8	4	0	12
Sawao Kato	8	3	1	12

# Quadro Medalhas Atletas Brasil
tabela_atletas <- dados_participacoes |> 
  filter(pais_sg == "BRA") |> 
  group_by(atleta_id, nome) |> 
  summarise(
    ouro   = sum(medalha == "Ouro", na.rm = TRUE),
    prata  = sum(medalha == "Prata", na.rm = TRUE),
    bronze = sum(medalha == "Bronze", na.rm = TRUE),
    .groups = "drop") |> 
  mutate(total_geral = ouro + prata + bronze) |> 
  arrange(desc(ouro), desc(prata), desc(bronze)) |> 
  slice(1:10) |> 
  select(nome, ouro, prata, bronze, total_geral)

# Elaboração da tabela
tabela_atletas |>
  gt() |>
  # Cabeçalho e Títulos
  tab_header(
    title = md("**QUADRO HISTÓRICO DE MEDALHAS**"),
    subtitle = md("Atletas Brasileiros com Melhor Desempenho nos Jogos na História<br>(1920 Antuérpia – 2022 Beijing)")) |>
  tab_style(
    style = cell_text(style = "italic"),
    locations = cells_title(groups = "subtitle")) |>
  cols_label(
    nome = "Atleta", 
    ouro = "Ouro", 
    prata = "Prata", 
    bronze = "Bronze", 
    total_geral = "Total") |>
  # Cores (Degradê de Medalhas)
  data_color(columns = ouro, palette = c("#FFD70030", "#FFD700")) |>
  data_color(columns = prata, palette = c("#C0C0C030", "#C0C0C0")) |>
  data_color(columns = bronze, palette = c("#CD7F3230", "#CD7F32")) |>
  # Estilização de Texto
  tab_style(
    style = cell_text(color = "black"),
    locations = cells_body(columns = everything())) |>
  tab_style(
    style = cell_text(weight = "bold"),
    locations = cells_body(columns = nome)) |>
  # Formatação Numérica e Alinhamento
  fmt_number(
    columns = c(ouro, prata, bronze, total_geral), 
    decimals = 0, 
    use_seps = TRUE, 
    sep_mark = ".", 
    dec_mark = ",") |>
  cols_align(align = "left", columns = nome) |>
  cols_align(align = "center", columns = c(ouro, prata, bronze, total_geral)) |>
  # Layout
  tab_options(
    heading.title.font.size = 24,
    column_labels.font.weight = "bold",
    table.width = pct(80))

QUADRO HISTÓRICO DE MEDALHAS
Atletas Brasileiros com Melhor Desempenho nos Jogos na História (1920 Antuérpia – 2022 Beijing)
Atleta	Ouro	Prata	Bronze	Total
Robert Scheidt	2	2	1	5
Serginho	2	2	0	4
Torben Grael	2	1	2	5
Marcelo Ferreira	2	0	1	3
Giovane	2	0	0	2
Maurício	2	0	0	2
Adhemar da Silva	2	0	0	2
Fabiana	2	0	0	2
Paula	2	0	0	2
Thaísa	2	0	0	2

Podemos aplicar outra visualização:

# Medalhas Atletas
quadro_atletas <- dados_participacoes |>
  filter(!is.na(medalha)) |> 
  # Conta a combinação de atleta e medalha
  count(nome, medalha) |> 
  # Transforma o tipo de medalha em colunas
  pivot_wider(
    names_from = medalha, 
    values_from = n, 
    values_fill = 0
  ) |> 
  mutate(across(any_of(c("Ouro", "Prata", "Bronze")), ~ .)) |>
  # Cria o total e ordena
  mutate(total = Ouro + Prata + Bronze) |> 
  arrange(desc(Ouro), desc(Prata), desc(Bronze)) |> 
  slice(1:10) |>
  mutate(nome = fct_reorder(nome, Ouro + Prata/1000 + Bronze/1000000))

# Plotagem
ggplot(quadro_atletas) +
  geom_segment(aes(x = pmin(Ouro, Prata, Bronze),
                   xend = pmax(Ouro, Prata, Bronze),
                   y = nome, yend = nome), color = "grey") +
  # Ouros
  geom_point(aes(x = Bronze, y= nome, color = "Bronze"), size = 8) +
  # Pratas
  geom_point(aes(x = Prata, y= nome, color = "Prata"), size = 6) +
  # Bronzes
  geom_point(aes(x = Ouro, y= nome, color = "Ouro"), size = 4) +
  # Tema, Legendas e Títulos
  scale_color_manual(
    name = "TIPO DE MEDALHA",
    values = c("Ouro" = "#FFD700", "Prata" = "#C0C0C0", "Bronze" = "#CD7F32"),
    breaks = c("Ouro", "Prata", "Bronze")) +
  labs(
    title = "QUADRO HISTÓRICO DE MEDALHAS",
    subtitle = "Atletas com Melhor Desempenho nos Jogos na História\n(1896 Atenas – 2022 Beijing)",
    x = "MEDALHAS",
    y = NULL) + 
  theme_olympics() + 
  theme(panel.grid.major.y = element_blank())

# Medalhas Atletas Brasil
quadro_atletas <- dados_participacoes |>
  filter(!is.na(medalha), pais_sg == "BRA") |> 
  # Conta a combinação de atleta e medalha
  count(nome, medalha) |> 
  # Transforma o tipo de medalha em colunas
  pivot_wider(
    names_from = medalha, 
    values_from = n, 
    values_fill = 0
  ) |> 
  mutate(across(any_of(c("Ouro", "Prata", "Bronze")), ~ .)) |>
  # Cria o total e ordena
  mutate(total = Ouro + Prata + Bronze) |> 
  arrange(desc(Ouro), desc(Prata), desc(Bronze)) |> 
  slice(1:10) |>
  mutate(nome = fct_reorder(nome, Ouro + Prata/1000 + Bronze/1000000))

# Plotagem
ggplot(quadro_atletas) +
  geom_segment(aes(x = pmin(Ouro, Prata, Bronze),
                   xend = pmax(Ouro, Prata, Bronze),
                   y = nome, yend = nome), color = "grey") +
  # Ouros
  geom_point(aes(x = Bronze, y= nome, color = "Bronze"), size = 8) +
  # Pratas
  geom_point(aes(x = Prata, y= nome, color = "Prata"), size = 6) +
  # Bronzes
  geom_point(aes(x = Ouro, y= nome, color = "Ouro"), size = 4) +
  # Tema, Legendas e Títulos
  scale_x_continuous(breaks = seq(0, 2, by =1)) + 
  scale_color_manual(
    name = "TIPO DE MEDALHA",
    values = c("Ouro" = "#FFD700", "Prata" = "#C0C0C0", "Bronze" = "#CD7F32"),
    breaks = c("Ouro", "Prata", "Bronze")) +
  labs(
    title = "QUADRO HISTÓRICO DE MEDALHAS",
    subtitle = "Atletas Brasileiros com Melhor Desempenho nos Jogos na História\n(1920 Antuérpia – 2022 Beijing)",
    x = "MEDALHAS",
    y = NULL) + 
  theme_olympics() + 
  theme(panel.grid.major.y = element_blank())

O nadador Michall Phelps quando comparado com os demais atletas apresenta uma quantidade de medalhas de ouro desproporcionalmente superior ao demais, enquanto isso, os atletas brasileiros aparentam um desempenho relativamente similar aos outros.

DISTRIBUIÇÃO DAS CIDADES SEDE

Agora vamos utilizar algumas informações geográficas. Para isso vamos precisar de algumas geoometrias espaciais.

# Preparação
cidades_sedes <- dados_latlong |> 
  filter(estacao == "Verão") |> 
  count(cidade, longitude, latitude, name = "ocorrencia")

cidades_sf_verao <- st_as_sf(cidades_sedes, 
                       coords = c("longitude", "latitude"), 
                       crs = 4326)

cidades_sedes <- dados_latlong |> 
  filter(estacao == "Inverno") |> 
  count(cidade, longitude, latitude, name = "ocorrencia")

cidades_sf_inverno <- st_as_sf(cidades_sedes, 
                       coords = c("longitude", "latitude"), 
                       crs = 4326)

# Mapa Mundi (Robinson)
mundo_sf <- ne_countries(scale = "large", returnclass = "sf") |> 
  filter(continent != "Antarctica")

Agora vamos analisar a distribuição das sedes olímpicas utilizando a ferramenta dos mapas.

# Plotagem
ggplot() +
  # Mapa
  geom_sf(data = mundo_sf, fill = "#F2F2F2", color = "#D1D1D1", size = 0.1) +
  # Cidades
  geom_sf(data = cidades_sf_verao, 
          aes(size = ocorrencia), 
          color = winter_swiss_1928_palette$primary[1],
          alpha = 0.6, 
          shape = 16) +
  # Adicionando um contorno sutil nos pontos para dar profundidade
  geom_sf(data = cidades_sf_verao, 
          aes(size = ocorrencia), 
          color = winter_swiss_1928_palette$primary[1], 
          shape = 21, 
          stroke = 0.5, 
          fill = NA) +
  # Projeção Robinson
  coord_sf(crs = "+proj=robin") + 
  # Escala de tamanhos
  scale_size_area(max_size = 6, breaks = c(1, 2, 3)) +
  # Títulos e Temas
  labs(
    title = "CIDADES QUE SEDIARAM OS JOGOS",
    subtitle = "Distribuição das Sedes das Olimpíadas de Verão (1896 Atenas – 2020 Tokyo)",
    size = "OCORRÊNCIAS") +
  theme_olympics() + 
  theme(axis.text.x = element_blank(),
        axis.text.y = element_blank())

# Plotagem
ggplot() +
  # Mapa
  geom_sf(data = mundo_sf, fill = "#F2F2F2", color = "#D1D1D1", size = 0.1) +
  # Cidades
  geom_sf(data = cidades_sf_inverno, 
          aes(size = ocorrencia), 
          color = winter_swiss_1928_palette$primary[3],
          alpha = 0.6, 
          shape = 16) +
  # Adicionando um contorno sutil nos pontos para dar profundidade
  geom_sf(data = cidades_sf_inverno, 
          aes(size = ocorrencia), 
          color = winter_swiss_1928_palette$primary[3], 
          shape = 21, 
          stroke = 0.5, 
          fill = NA) +
  # Projeção Robinson
  coord_sf(crs = "+proj=robin") + 
  # Escala de tamanhos
  scale_size_area(max_size = 4, breaks = c(1, 2)) +
  # Títulos e Temas
  labs(
    title = "CIDADES QUE SEDIARAM OS JOGOS",
    subtitle = "Distribuição das Sedes das Olimpíadas de Inverno (1896 Atenas – 2022 Beijing)",
    size = "OCORRÊNCIAS") +
  theme_olympics() + 
  theme(axis.text.x = element_blank(),
        axis.text.y = element_blank())

Os mapas nos mostram que a distribuição dos países que realizam os jogos olímpicos é bastante heterogênea. Existe uma concentração na Europa e na América Anglo-Saxônica, com poucos casos na Ásia, Oceania e na América Latina (Nenhuma ocorrência no continente africano).

Por conta da grande densidade de pontos no continente europeu, vamos observar mais de perto esses casos.

# Plotagem com Zoom na Europa
ggplot() +
  # Mapa
  geom_sf(data = mundo_sf, fill = "#F2F2F2", color = "#D1D1D1", size = 0.1) +
  # Cidades
  geom_sf(data = cidades_sf_verao,
          aes(size = ocorrencia), 
          color = winter_swiss_1928_palette$primary[1],
          alpha = 0.6, 
          shape = 16) +
  # Contorno sutil
  geom_sf(data = cidades_sf_verao, 
          aes(size = ocorrencia), 
          color = winter_swiss_1928_palette$primary[1], 
          shape = 21, 
          stroke = 0.5, 
          fill = NA) +
  # Usamos crs = 4326 para que os limites x e y funcionem como esperado
  coord_sf(xlim = c(-15, 42), ylim = c(33, 68), expand = FALSE) + 
  scale_size_area(max_size = 8, breaks = c(1, 2, 3)) +
  labs(
    title = "FOCO: SEDES EUROPEIAS",
    subtitle = "Olimpíadas de Verão na Europa (1896 Atenas – 2012 Londres)",
    size = "OCORRÊNCIAS") +
  theme_olympics() + 
  theme(axis.text.x = element_blank(),
        axis.text.y = element_blank())

# Plotagem com Zoom na Europa
ggplot() +
  # Mapa
  geom_sf(data = mundo_sf, fill = "#F2F2F2", color = "#D1D1D1", size = 0.1) +
  # Cidades
  geom_sf(data = cidades_sf_inverno, 
          aes(size = ocorrencia), 
          color = winter_swiss_1928_palette$primary[3],
          alpha = 0.6, 
          shape = 16) +
  # Contorno sutil
  geom_sf(data = cidades_sf_inverno, 
          aes(size = ocorrencia), 
          color = winter_swiss_1928_palette$primary[3], 
          shape = 21, 
          stroke = 0.5, 
          fill = NA) +
  # Usamos crs = 4326 para que os limites x e y funcionem como esperado
  coord_sf(xlim = c(-15, 42), ylim = c(33, 68), expand = FALSE) + 
  scale_size_area(max_size = 8, breaks = c(1, 2, 3)) +
  labs(
    title = "FOCO: SEDES EUROPEIAS",
    subtitle = "Olimpíadas de Inverno na Europa (1924 Chamonix – 2014 Sóchi)",
    size = "OCORRÊNCIAS") +
  theme_olympics() + 
  theme(axis.text.x = element_blank(),
        axis.text.y = element_blank())

IMPACTO DE SEDIAR OS JOGOS SOBRE O DESEMPENHO

Para investigar a existência de um possível efeito sede, construímos duas métricas de desempenho comparáveis entre países e edições:

• Score: medida ponderada de medalhas, na qual atribuímos pesos diferentes para cada tipo de premiação (ouro = 4 pontos, prata = 2 pontos e bronze = 1 ponto);
• Índice de Medalhas: proporção de medalhas conquistadas por um país em determinada edição em relação ao total de medalhas distribuídas naquela edição.

A primeira métrica permite capturar não apenas a quantidade, mas também a qualidade das medalhas obtidas. Já o índice de medalhas controla o tamanho da edição, tornando comparáveis Jogos com diferentes números de provas e participantes.

Para calcular essas medidas, construímos uma base por país e edição. Além do cálculo das métricas, identificamos se o país atuava como sede naquela edição, contabilizamos o número de atletas enviados por delegação e atribuímos o continente correspondente a cada país. Também excluímos equipes mistas e atletas independentes, pois não podem ser associados a um país específico, o que comprometeria a análise do efeito sede.

athlete_count <- athlete_event_result |>
  select(
    edition_id,
    country_noc,
    athlete_id
  ) |>
  group_by(edition_id, country_noc) |>
  summarise(
    n_athletes = n_distinct(athlete_id),
    .groups = "drop"
  )

medals_per_country_per_edition <- game_medal_tally |>
  left_join(
    game |> select(edition_id, host_country), 
    by = "edition_id"
  ) |>
  mutate(
    is_host = country_noc == host_country,
    score_total  = (4 * gold) + (2 * silver) + bronze,
  ) |>
  group_by(country_noc, edition_id, year, edition) |>
  summarise(
    gold = sum(gold, na.rm = TRUE),
    silver = sum(silver, na.rm = TRUE),
    bronze = sum(bronze, na.rm = TRUE),
    total = sum(total, na.rm = TRUE),
    is_host = any(is_host),
    score_total = sum(score_total, na.rm = TRUE),
    .groups = "drop"
  )  |>
  mutate(
    continent = countrycode(country_noc, "ioc", "continent"),
    # Países que deixaram de existir ou outros grupos
    continent = case_when(
      country_noc == "AHO" ~ "Americas",   # Netherlands Antilles
      country_noc == "ANZ" ~ "Oceania",    # Australasia
      country_noc == "BOH" ~ "Europe",     # Bohemia
      country_noc == "EUN" ~ "Europe",     # Equipe Unificada
      country_noc == "FRG" ~ "Europe",     # Alemanha Ocidental
      country_noc == "GDR" ~ "Europe",     # Alemanha Oriental
      country_noc == "IOA" ~ NA_character_,# Atletas Independentes
      country_noc == "KOS" ~ "Europe",     # Kosovo
      country_noc == "MIX" ~ NA_character_,# Mixed Team
      country_noc == "ROC" & year < 2020 ~ "Asia",    # Taiwan/China
      country_noc == "ROC" & year >= 2020 ~ "Europe", # Comitê Olímpico Russo
      country_noc == "SCG" ~ "Europe",     # Sérvia e Montenegro
      country_noc == "TCH" ~ "Europe",     # Tchecoslováquia
      country_noc == "UAR" ~ "Africa",     # República Árabe Unida (Egito)
      country_noc == "URS" ~ "Europe",     # União Soviética
      country_noc == "WIF" ~ "Americas",   # West Indies Federation (Caribe)
      country_noc == "YUG" ~ "Europe",     # Iugoslávia
      TRUE ~ continent
    )
  ) |>
  group_by(edition_id) |>
  mutate(
    medal_rate = total / sum(total)
  ) |>
  ungroup() |>
  filter(!is.na(continent)) |>
  left_join(athlete_count, by = c("edition_id", "country_noc"))

SCORE ACUMULADO

Além da análise por edição, é interessante observar o desempenho dos países de forma acumulada ao longo do tempo. O score acumulado permite visualizar a consolidação histórica das potências olímpicas, mostrando quais países mantêm um desempenho consistente ao longo das décadas. Para construir essa métrica, ordenamos os dados por país e ano e aplicamos a soma acumulada do score total obtido em cada edição.

score_cum <- medals_per_country_per_edition |>
  arrange(country_noc, edition_id) |>
  group_by(country_noc, edition) |>
  mutate(
    score_cum = cumsum(score_total)
  ) |>
  ungroup() |>
  select(
    country_noc,
    continent,
    year,
    edition,
    is_host,
    score = score_cum
  ) |>
  mutate(
    edition = factor(
      edition,
      levels = c("Olimpíadas de Verão",
                 "Olimpíadas de Inverno")
    )
  )

Dessa forma, cada ponto no gráfico representa o total de pontos já conquistados pelo país até aquele ano.

# Labels que aparecerão no gráfico
huge_score <- score_cum |>
  group_by(country_noc, edition) |>
  filter((edition == "Olimpíadas de Verão" & score >= 2000) | (edition == "Olimpíadas de Inverno" & score >= 450)) |>
  slice_max(year, n = 1)

ggplot(
    score_cum,
    aes(x = year, y = score, color = continent, group = country_noc)
  ) +
  geom_line(size = 0.8, alpha = 0.6) +
  scale_color_manual(
    name   = "Continente",
    values = c(
      "Africa"   = "#F26E22",
      "Americas" = "#7ABF49",
      "Asia"     = "#F2B90C",
      "Europe"   = "#03588C",
      "Oceania"  = "#A60D0D"
    ),
    labels = c(
      "Africa"   = "África",
      "Americas" = "América",
      "Asia"     = "Ásia",
      "Europe"   = "Europa",
      "Oceania"  = "Oceania"
    )
  ) +
  geom_point(
    data = huge_score,
    size = 2,
    color = "black",
    show.legend = FALSE
  ) +
  geom_text_repel(
    data = bind_rows(huge_score),
    aes(label = country_noc),
    size = 3,
    color = "black",
    show.legend = FALSE
  ) +
  facet_wrap(~ edition, ncol = 2, scales = "free") +
  labs(
    title = "Evolução do score acumulado por país",
    x = NULL,
    y = "Score acumulado",
    caption = "Fonte: Base dos Dados - Historical Data from the Olympics"
  ) +
  theme_olympics()

Como o número de países é elevado, a parte inferior do gráfico se torna visualmente poluída. Por isso, em seguida apresentamos uma versão focada nos três países com maior score atual em cada continente.

# Busca os 3 países com o maior score atual por continente
top_countries <- score_cum |>
  group_by(edition, continent, country_noc) |>
  slice_max(year, n = 1) |>
  ungroup() |>
  group_by(edition, continent) |>
  slice_max(score, n = 3) |>
  ungroup() |>
  select(edition, continent, country_noc)

# Pega as informações dos melhores países
top_by_continent <- score_cum |>
  semi_join(
    top_countries,
    by = c("edition", "continent", "country_noc")
  )

# Labels que aparecerão no gráfico
labels_data <- top_by_continent |>
  group_by(edition, country_noc) |>
  arrange(year, .by_group = TRUE) |>
  mutate(
    group_id = cur_group_id(),
    n = n(),
    label_position = round(n * (0.1 + 0.2 * (group_id %% 3))),
    continent = continent
  ) |>
  filter(row_number() == label_position) |>
  ungroup()

ggplot(
  top_by_continent,
  aes(x = year, y = score, color = continent, group = country_noc)
) +
  geom_line(size = 0.8, alpha = 0.6) +
  scale_color_manual(
    name   = "Continente",
    values = c(
      "Africa"   = "#F26E22",
      "Americas" = "#7ABF49",
      "Asia"     = "#F2B90C",
      "Europe"   = "#03588C",
      "Oceania"  = "#A60D0D"
    ),
    labels = c(
      "Africa"   = "África",
      "Americas" = "América",
      "Asia"     = "Ásia",
      "Europe"   = "Europa",
      "Oceania"  = "Oceania"
    )
  ) +
  geom_text_repel(
    data = labels_data,
    aes(label = country_noc, color = continent),
    size = 3,
    fontface = "bold",
    show.legend = FALSE
  ) +
  facet_wrap(~ edition, ncol = 2, scales = "free") +
  labs(
    title = "Evolução do score acumulado por país",
    subtitle = "Top 3 atuais por continente",
    x = NULL,
    y = "Score acumulado",
    caption = "Fonte: Base dos Dados - Historical Data from the Olympics"
  ) +
  theme_olympics()

No caso da América, observa-se que o Brasil não está entre os três países com os maiores scores atuais. Isso motiva uma análise específica da evolução brasileira dentro do continente, destacando sua trajetória histórica e comparando-a com outras nações americanas.

# Labels que aparecerão no gráfico
labels_data <- score_cum |>
  filter(continent == "Americas") |>
  group_by(edition, country_noc) |>
  arrange(year, .by_group = TRUE) |>
  mutate(
    group_id = cur_group_id(),
    n = n(),
    label_position = round(n * (0.1 + 0.3 * (group_id %% 3)))
  ) |>
  filter(row_number() == label_position) |>
  ungroup()

ggplot(
  score_cum |> filter(continent == "Americas"),
  aes(
    x = year,
    y = score, 
    color = country_noc,
  )
  ) +
  geom_line(size = 0.8, show.legend = FALSE) +
  geom_text_repel(
    data = labels_data,
    aes(label = country_noc),
    size = 3,
    fontface = "bold",
    show.legend = FALSE
  ) +
  scale_color_manual(
    values = c(
      winter_italy_1956_palette$primary,
      summer_brasil_2016_palette$primary,
      summer_canada_1976_palette$primary,
      winter_germany_1936_palette$primary,
      summer_usa_1932_palette$primary,
      winter_swiss_1928_palette$primary
    )
  ) +
  facet_wrap(~ edition, ncol = 2, scales = "free") +
  labs(
    title = "Evolução do score acumulado por país",
    subtitle = "América",
    x = NULL,
    y = "Score acumulado",
    caption = "Fonte: Base dos Dados - Historical Data from the Olympics"
  ) +
  theme_olympics()

Apesar do recorte continental reduzir a complexidade da visualização, ainda há muitas curvas sobrepostas, o que dificulta a leitura da trajetória específica do Brasil. Ao destacar o Brasil, conseguimos observar melhor seu ritmo de crescimento e sua posição relativa dentro do continente.

ggplot(
  score_cum |> filter(continent == "Americas"),
  aes(
    x = year,
    y = score, 
    color = country_noc, 
    alpha = country_noc == "BRA" | edition == "Olimpíadas de Inverno")
) +
  scale_alpha_manual(
    values = c(
      "TRUE" = 1,
      "FALSE" = 0.3
    ),
    guide = "none"
  ) +
  geom_line(size = 0.8, show.legend = FALSE) +
  geom_text_repel(
    data = labels_data,
    aes(label = country_noc, color = country_noc),
    size = 3,
    fontface = "bold",
    show.legend = FALSE
  ) +
  scale_color_manual(
    values = c(
      winter_italy_1956_palette$primary,
      summer_brasil_2016_palette$primary,
      summer_canada_1976_palette$primary,
      winter_germany_1936_palette$primary,
      summer_usa_1932_palette$primary,
      winter_swiss_1928_palette$primary
    )
  ) +
  facet_wrap(~ edition, ncol = 2, scales = "free") +
  labs(
    title = "Evolução do score acumulado por país",
    subtitle = "América - Brasil em destaque",
    x = NULL,
    y = "Score acumulado",
    caption = "Fonte: Base dos Dados - Historical Data from the Olympics"
  ) +
  theme_olympics()

COMPARAÇÃO ENTRE MÉTRICAS

Para comparar as métricas, utilizaremos os mesmos gráficos feitos com as duas métricas. Para atingir nosso propósito, precisamos de alguns dados gerais sobre o desempenho brasileiro.

mean_brasil <- medals_per_country_per_edition |>
  filter(country_noc == "BRA") |>
  group_by(edition, is_host) |>
  summarise(
    mean_score = mean(score_total),
    mean_medal_rate = mean(medal_rate),
    .groups = "drop"
  ) |>
  mutate(
    is_host = factor(
      is_host,
      levels = c(TRUE, FALSE),
      labels = c("Sede", "Não sede")
    )
  )

O primeiro gráfico que plotaremos é um boxplot do desempenho por país em cada métrica com destaque para o Brasil.

# Score
score_by_country <- medals_per_country_per_edition |>
  mutate(
    is_host = factor(
      is_host,
      levels = c(TRUE, FALSE),
      labels = c("Sede", "Não sede")
    )
  ) |>
  ggplot(aes(x = is_host, y = score_total, fill = is_host)) +
  geom_boxplot(alpha = 0.8, width = 0.6, show.legend = FALSE) +
  geom_point(
    data = mean_brasil,
    aes(x = is_host, y = mean_score),
    shape = 23,
    size = 2,
    stroke = 0.8,
    color = "black",
    fill = "yellow"
  ) +
  facet_wrap(~ edition, scales = "free") +
  scale_fill_manual(values = summer_brasil_2016_palette$primary) +
  labs(
    x = NULL,
    y = "Score"
  ) +
  theme_olympics()

# Índice de medalhas
medal_rate_by_country <- medals_per_country_per_edition |>
  mutate(
    is_host = factor(
      is_host,
      levels = c(TRUE, FALSE),
      labels = c("Sede", "Não sede")
    )
  ) |>
  ggplot(aes(x = is_host, y = medal_rate, fill = is_host)) +
  geom_boxplot(alpha = 0.8, width = 0.6, show.legend = FALSE) +
  geom_point(
    data = mean_brasil,
    aes(x = is_host, y = mean_medal_rate),
    shape = 23,
    size = 2,
    stroke = 0.8,
    color = "black",
    fill = "yellow"
  ) +
  facet_wrap(~ edition, scales = "free") +
  scale_fill_manual(values = summer_brasil_2016_palette$primary) +
  labs(
    x = NULL,
    y = "Índice de Medalhas"
  ) +
  theme_olympics()

(score_by_country + medal_rate_by_country) +
  plot_layout(widths = c(1, 1)) +
  plot_annotation(
    title = "Métricas por país",
    subtitle = "Brasil destacado",
    caption = "Fonte: Base dos Dados - Historical Data from the Olympics"
  ) &
  theme(
    plot.title = element_text(face = "bold", size = 18),
    plot.subtitle = element_text(face = "italic", size = 13, margin = margin(b = 8)),
    plot.caption = element_text(size = 11, color = "gray10")
  )

Embora baseadas em aspectos distintos, as duas métricas apresentam padrões semelhantes entre si. O Score enfatiza a qualidade das medalhas conquistadas, ao atribuir pesos diferentes, enquanto o Índice de Medalhas captura a participação relativa do país no total de premiações. A semelhança dos resultados indica que sediar os Jogos tende a ampliar tanto o volume de medalhas quanto a relevância do desempenho. Assim, podemos analisar qual foi o impacto das olimpíadas de 2016 no desempenho brasileiro.

score_athletes <- medals_per_country_per_edition |>
  filter(country_noc == "BRA") |>
  mutate(
    is_host = factor(
      is_host,
      levels = c(TRUE, FALSE),
      labels = c("Sede", "Não sede")
    )
  ) |>
  ggplot(
    aes(
      x = year, 
      y = score_total, 
      color = is_host,
      size = n_athletes
    )
  ) +
  geom_point(alpha = 0.6, stroke = 1.2) +
  scale_color_manual(values = summer_brasil_2016_palette$primary, name = NULL) +
  scale_size_continuous(range = c(2, 12)) +
  labs(
    x = NULL,
    y = "Score"
  ) +
  guides(size = "none") +
  theme_olympics()

# Índice de Medalhas
medal_rate_athletes <- medals_per_country_per_edition |>
  filter(country_noc == "BRA") |>
  mutate(
    is_host = factor(
      is_host,
      levels = c(TRUE, FALSE),
      labels = c("Sede", "Não sede")
    )
  ) |>
  ggplot(
    aes(
      x = year, 
      y = medal_rate, 
      color = is_host,
      size = n_athletes
    )
  ) +
  geom_point(alpha = 0.6, stroke = 1.2) +
  scale_color_manual(values = summer_brasil_2016_palette$primary, name = NULL) +
  scale_size_continuous(range = c(2, 12)) +
  labs(
    x = NULL,
    y = "Índice de Medalhas"
  ) +
  guides(size = "none") +
  theme_olympics()

(score_athletes + medal_rate_athletes) +
  plot_layout(widths = c(1, 1)) +
  plot_annotation(
    title = "Métricas brasileiras por edição nos jogos de verão",
    subtitle = "Tamanho do ponto representa o número de atletas medalhistas",
    caption = "Fonte: Base dos Dados - Historical Data from the Olympics"
  ) &
  theme(
    plot.title = element_text(face = "bold", size = 18),
    plot.subtitle = element_text(face = "italic", size = 13, margin = margin(b = 8)),
    plot.caption = element_text(size = 11, color = "gray10")
  )

A visualização temporal sugere que podem haver efeitos que se estendem além do ano em que o país foi sede dos jogos. Observa-se um aumento no número de atletas em 2016, o que é esperado, dado que o país sede possui vagas automáticas em diversas modalidades. Esse aumento pode explicar parte do crescimento no desempenho. Entretanto, como os resultados competitivos em 2020 se mantém perto dos resultados de 2016, o impacto pode não se restringir ao ano em que o país é sede. Tentando ver como esse efeito sede se comporta no geral, vamos calculá-lo para os outros países para compará-lo com o efeito sede brasileiro.

host_effect_score <- medals_per_country_per_edition |>
  group_by(country_noc, edition, is_host) |>
  summarise(
    mean_score = mean(score_total),
    .groups = "drop"
  ) |>
  pivot_wider(
    names_from = is_host,
    values_from = mean_score
  ) |>
  mutate(
    host_effect = `TRUE` - `FALSE`,
    is_brasil = country_noc == "BRA"
  ) |>
  filter(!is.na(host_effect))

host_effect_medal_rate <- medals_per_country_per_edition |>
  group_by(country_noc, edition, is_host) |>
  summarise(
    mean_medal_rate = mean(medal_rate),
    .groups = "drop"
  ) |>
  pivot_wider(
    names_from = is_host,
    values_from = mean_medal_rate
  ) |>
  mutate(
    host_effect = `TRUE` - `FALSE`,
    is_brasil = country_noc == "BRA"
  ) |>
  filter(!is.na(host_effect))

Assim, podemos plotar um boxplot para entender o efeito sede geral.

score_host_effect <- ggplot(host_effect_score, aes(x = edition, y = host_effect, fill = edition)) +
  geom_boxplot(alpha = 0.8, width = 0.6, show.legend = FALSE) +
  geom_point(
    data = host_effect_score |> filter(country_noc == "BRA"),
    aes(x = edition, y = host_effect),
    shape = 23,
    size = 2,
    stroke = 0.8,
    color = "black",
    fill = "yellow"
  ) +
  scale_fill_manual(values = winter_italy_1956_palette$secondary) +
  labs(
    x = NULL,
    y = "Efeito Sede (Score)",
    color = NULL
  ) +
  theme_olympics()

medal_rate_host_effect <- ggplot(host_effect_medal_rate, aes(x = edition, y = host_effect, fill = edition)) +
  geom_boxplot(alpha = 0.8, width = 0.6, show.legend = FALSE) +
  geom_point(
    data = host_effect_medal_rate |> filter(country_noc == "BRA"),
    aes(x = edition, y = host_effect),
    shape = 23,
    size = 2,
    stroke = 0.8,
    color = "black",
    fill = "yellow"
  ) +
  scale_fill_manual(values = winter_italy_1956_palette$secondary) +
  labs(
    x = NULL,
    y = "Efeito Sede (Índice de Medalhas)",
    color = NULL
  ) +
  theme_olympics()

(score_host_effect + medal_rate_host_effect) +
  plot_layout(widths = c(1, 1)) +
  plot_annotation(
    title = "Distribuição do Efeito Sede por País",
    subtitle = "Diferença média de pontuação - Brasil destacado",
    caption = "Fonte: Base dos Dados - Historical Data from the Olympics"
  ) &
  theme(
    plot.title = element_text(face = "bold", size = 18),
    plot.subtitle = element_text(face = "italic", size = 13, margin = margin(b = 8)),
    plot.caption = element_text(size = 11, color = "gray10")
  )

Os boxplots indicam que, em média, a distribuição do efeito sede é positiva, tanto quando medido pelo Score quanto pelo Índice de Medalhas. Isso sugere que, de maneira geral, os países tendem a apresentar desempenho superior quando competem em casa. A mediana acima de zero em ambas as métricas reforça a hipótese da existência de um efeito sede estrutural, e não apenas uma coincidência.

CONCLUSÃO E OBSERVAÇÕES

Inicialmente, podemos perceber ao longo da análise uma heterogeneidade na distribuição dos atletas, medalhas e sediamento do evento. Apesar de representar menos de 15% da população mundial, a Europa e a América do Norte compõem os principais quadros de medalhas. Isso indica que apesar de propor uma dinâmica internacional do esporte, os recursos necessários para a garantia de fornecer treinamento, suporte e envio de atletas ainda não são uma realidade palpável para a maioria das nações.

A partir das métricas construídas, identificou-se a existência de um efeito sede nos Jogos Olímpicos. Tanto o Score quanto o Índice de Medalhas indicam que, em média, os países tendem a apresentar desempenho superior quando competem como anfitriões, com medianas positivas em ambas as medidas. Apesar de capturarem dimensões distintas, as duas métricas apresentaram resultados convergentes. Isso sugere que sediar os Jogos pode ampliar não apenas o volume absoluto de medalhas, mas também a relevância proporcional do desempenho.

No caso brasileiro, observou-se melhora expressiva em 2016, acompanhada por aumento no número de atletas. Parte desse efeito pode ser explicada por fatores como maior delegação e apoio da torcida, mas os resultados em 2020 indicam que investimentos realizados no ciclo olímpico também podem ter contribuído. Entretanto, a dispersão observada no caso geral mostra que os ganhos variam significativamente, sugerindo que o impacto também depende de características estruturais, como tradição esportiva e capacidade de investimento. Além disso, países escolhidos para sediar os Jogos frequentemente já possuem forte histórico esportivo.

REFERÊNCIAS

BASE DOS DADOS. Historical Data from the Olympics. Disponível em: https://basedosdados.org/dataset/62f8cb83-ac37-48be-874b-b94dd92d3e2b.

FLOURISH. How to visualize the Olympics. Disponível em: https://flourish.studio/blog/visualizing-olympics/.

FLOWINGDATA. History of Sumo Charted. Disponível em: https://flowingdata.com/2016/05/16/history-of-sumo-charted/.

OLYMPEDIA. Olympedia. Disponível em: https://www.olympedia.org/.

SCIELO. Visual abstracts. Disponível em: https://www.scielo.br/j/jbn/a/4kqVkwSqkgFTbdC9VgThvnP/?format=pdf&lang=pt.

THE OLYMPIC DESIGN. Olympic Games – The Design. Disponível em: https://www.theolympicdesign.com/.

APÊNDICE - PALETAS E TEMA

# Paletas
winter_france_1924_palette <- list(
  primary = c("#07598C", "#F2A413", "#A63B32", "#BF491F", "#F0EADC"),
  secondary = c("#012340", "#025E73", "#D9A404", "#D97904", "#D9C5A0"),
  tertiary = c("#3E4649", "#7897BF", "#A6294B", "#D9593D", "#F2EFDF"),
  quaternary = c("#3285A6", "#4694A6", "#D97904", "#D96704", "#A60D0D")
)

winter_swiss_1928_palette <- list(
  primary = c("#BF0B1A", "#EEC50B", "#065473", "#157A74", "#F1F3E5")
)

summer_usa_1932_palette <- list(
  primary = c("#0E4459", "#1F6373", "#E09714", "#BF1717", "#F2E5D5")
)

winter_germany_1936_palette <- list(
  primary = c("#040B11", "#2D2273", "#F2D544", "#D91111", "#F2E8DC")
)

winter_italy_1956_palette <- list(
  primary = c("#001D2D", "#037F8C", "#F2C335", "#BF3C1F", "#D9C6B0"),
  secondary = c("#0D0F1B", "#263F8C", "#F2CE1B", "#D92211", "#F2F0EB")
)

summer_canada_1976_palette <- list(
  primary = c("#2C2C24", "#0367A6", "#0378A6", "#D91E0D", "#F2F2EB"),
  secondary = c("#0477BF", "#1AA3D9", "#F2F2EB", "#F2CE16", "#F29F05")
)

summer_brasil_2016_palette <- list(
  primary = c("#03588C", "#7ABF49", "#F2B90C", "#F26E22", "#F2F2F2")
)

theme_olympics <- function(pallete) {
  theme_minimal(base_size = 12) +
    theme(
      plot.margin = margin(
        t = 10,
        r = 15,
        b = 10,
        l = 15
      ),
      plot.title = element_text(face = "bold", size = 16),
      plot.subtitle = element_text(face = "italic", size = 12, margin = margin(b = 8)),
      plot.caption = element_text(size = 9, color = "gray10"),
      strip.text = element_text(face = "bold", size = 11),
      strip.background = element_rect(fill = "gray90", color = NA),
      axis.title = element_text(face = "bold", size = 10),
      axis.text.y = element_text(face = "italic"),
      panel.grid.minor = element_blank(),
      panel.grid.major.x = element_blank(),
      panel.grid.major.y = element_line(color = "gray85")
    )
}